home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 071 - EXFER 4.1 4.2.dsk / EXFER.SYS.S < prev    next >
Text File  |  2019-02-17  |  23KB  |  618 lines
  1.                          ; ****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;  "Pro" 1.2 and "Pro" 1.3.
  9.                          ;
  10.                          ; Written by: Mike Golaszewski
  11.                          ; (C)1986, All Rights Reserved
  12.                          ;
  13.                          ; ****************************
  14.  
  15.                          ; THIS IS NOT FREEWARE
  16.  
  17.                          ; system segment, version 4.0
  18.  
  19.                          ; created 08/23/86 - modified 11/09/87
  20.  
  21.                          ; Special thanks to Mark Roberts for providing much of the ideas and concepts
  22.                          ; found in EXfer, and for vigorously testing the program; Jerry Cline for his
  23.                          ; ideas and suggestions; Kieth Christian for his support; Lance Taylor-Warren
  24.                          ; for providing GBBS 1.3 information; and especially Greg Schaefer ("Gee Ess")
  25.                          ; for all his input.
  26.  
  27.                          ; define link in labels
  28.  
  29.           public add
  30.           public create
  31.           public external
  32.           public sort
  33.           public credit
  34.  
  35.                          ; external commands
  36.                          ; ~~~~~~~~~~~~~~~~~
  37.  
  38.                          ; get & parse command string
  39.  
  40. external
  41.           on nocar goto terminate
  42.           input @2 "External: " i$
  43.           if i$="?" goto ex.mnu
  44.           a=instr(" ",i$):if a=0 goto ret
  45.           x$=left$(i$,a-1):b=instr(",",i$)
  46.           if not(b) then y$=mid$(i$,a+1):z$="":goto ext.1
  47.           y$=mid$(i$,a+1,b-1):z$=mid$(i$,b+1)
  48.  
  49. ext.1
  50.           if x$="D" or x$="DUMP" goto dump
  51.           if x$="H" or x$="HELP" goto hedit
  52.           if x$="S" or x$="SWAP" goto swap
  53.           if x$="P" or x$="PURGE" goto purge
  54.           if x$="R" or x$="RESET" goto reset
  55.           if x$="Z" or x$="ZAP" goto zap
  56.           print \"XT:"chr$(7)" Command not recognized":goto ret
  57.  
  58. ex.mnu
  59.           print'
  60. DUMP      x        dump directory to printer
  61. HELP      command  edit help on command
  62. SWAP      x1,x2    swap two libraries
  63. PURGE     x       purge library
  64. RESET     x       reset library
  65. ZAP       x         zero out library'
  66.           print:goto external
  67.  
  68.                          ; :::::::::::::::::::::::::::::::::::::
  69.                          ; external command functions begin here
  70.                          ; :::::::::::::::::::::::::::::::::::::
  71.  
  72.                          ; swap two libraries
  73.                          ; ~~~~~~~~~~~~~~~~~~
  74.  
  75. swap
  76.           b=val(y$):c=val(z$)
  77.           if (b<1 or b>255) or (c<1 or c>255) or (b=c) goto ret
  78.  
  79.                          ; commence swapping
  80.  
  81.           i$="R A1:XV."+str$(b)+",A1:X.TEMP"
  82.           use "a:xdos",i$:i$="R A1:XV."+str$(c)+",A1:XV."+str$(b)
  83.           use "a:xdos",i$:i$="R A1:X.TEMP,A1:XV."+str$(c)
  84.           use "a:xdos",i$:i$="R A1:DV."+str$(b)+",A1:X.TEMP"
  85.           use "a:xdos",i$:i$="R A1:DV."+str$(c)+",A1:DV."+str$(b)
  86.           use "a:xdos",i$:i$="R A1:X.TEMP,A1:DV."+str$(c)
  87.           use "a:xdos",i$
  88.  
  89.                          ; update the bit map
  90.  
  91.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  92.           x=peek(ed+b):y=peek(ed+c):poke ed+b,y:poke ed+c,x
  93.           open #1,"a1:xt.bitmap":write #1,ed+1,255:close
  94.  
  95.                          ; switch names in volume file
  96.  
  97.           open #1,"a1:xt.volumes":position #1,32,b
  98.           input #1,x$:position #1,32,c:input #1,y$
  99.           position #1,32,b:print #1,y$:position #1,32,c
  100.           print #1,x$:close:print \"XT: Libraries swapped..."
  101.           push ret:goto log
  102.  
  103.                          ; edit entry in the help file
  104.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  105.  
  106. hedit
  107.           x=instr(y$,"CDFHIKLMNRSTVX?B"):if not(x) goto ret
  108.           ready "a1:hlp.exfer":input #msg(x),a,x$:input #6,x$
  109.           edit(0):copy #6,#8:print '
  110. Edit      help message: 'edit(3)' cols, [4K] max
  111. [DONE]    when finished, [.H] for help'
  112.           edit(1):if not(edit(2)) goto ret
  113.           print \"XT: Enter command line [ie: D)irectory]"
  114.           input @3 "  :>" i$:if i$="" goto ret:else kill #msg(x)
  115.           print #msg(x),x,y$:print #6,i$:copy #8,#6:msg(x)=1
  116.           update:ready d2$:goto ret
  117.  
  118.                          ; purge files from a directory
  119.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  120.  
  121. purge
  122.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then bb=ob:push ret:goto log
  123.           print \"XT: ["bn$"]"\:input @2 "XT: Purge this volume ? " i$
  124.           i$=left$(i$,1):if i$<>"Y" then bb=ob:push ret:goto log
  125.           input @0 \"XT: Remove files from disk ? " z$
  126.           open #1,d1$:print \"XT: "byte(4)" entries; purging #002";
  127.           for l=1 to byte(4):print chr$(8,3);right$("00"+str$(l),3);
  128.           position #1,32,l+1:input #1,i$:if i$="" next:goto purge.1
  129.           if z$="Y" gosub name:f$=bf$+f$:kill f$
  130.           position #1,32,l+1:print #1,chr$(13):next
  131.  
  132. purge.1
  133.           close:print chr$(8,3)"---":byte(4)=2:open #1,d1$
  134.           print #1,bn$:print #1,bf$:write #1,ram2,9:close
  135.           ready "g:mail":kill d2$:print '
  136. XT:       Creating new description file...':gosub make.msg:ready d2$
  137.           bb=ob:push ret:goto log
  138.  
  139.                          ; erase trashed file information
  140.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  141.  
  142. reset
  143.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then ob=bb:push ret:goto log
  144.           print \"XT: ["bn$"]"\:input @2 "XT: Reset file information ? " i$
  145.           i$=left$(i$,1):if i$<>"Y" then bb=ob:push ret:goto log
  146.           open #1,d1$:print \"XT: "byte(4)" entries; erasing #002";
  147.           for l=1 to byte(4):print chr$(8,3);right$("00"+str$(l),3);
  148.           position #1,32,l+1:input #1,i$:if i$="" next:goto reset.1
  149.           input #1,x$:read #1,ram2+9,10:byte(14)=0:position #1,32,l+1
  150.           print #1,i$:print #1,x$:write #1,ram2+9,10:next
  151.  
  152. reset.1
  153.           close:print chr$(8,3)"---":ready "g:mail":kill d2$:print '
  154. XT:       Creating new description file...':gosub make.msg:ready d2$
  155.           bb=ob:push ret:goto log
  156.  
  157.                          ; send a directory to the printer
  158.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  159.  
  160. dump
  161.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then ob=bb:push ret:goto log
  162.           y=5:gosub dir.h:use "a1:xtyp",bf$:open #1,d1$:for l=1 to byte(4)
  163.           position #1,32,l+1:input #1,i$:input #1,ty$:position #1,32,l+1,20
  164.           read #1,ram2+9,10:if i$="" goto dump.1:else na$=i$:gosub name
  165.           a$=bf$+f$:f$=na$:gosub dir.e:print #5
  166.  
  167. dump.1
  168.           next:close
  169.  
  170.                          ; print 
  171.  
  172.           x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256:z=x-y
  173.           print #5,\"Kbytes Free: "left$(str$(z)+chr$(32,3),4);
  174.           print #5,"   "right$("   Kbytes Used: "+str$(y),19);
  175.           print #5,"        Total Kbytes: "x:print #5,chr$(12)
  176.           bb=ob:push ret:goto log
  177.  
  178.                          ; Zap a library out of existance
  179.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  180.  
  181. zap
  182.           x=val(y$):i$="d a1:xv."+str$(x)
  183.           use "a:dos",i$:i$=d a1:dv."+str$(x)
  184.           use a:xdos",i$
  185.  
  186.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  187.           poke ed+x,255
  188.           open #1,"a1:xt.bitmap":write #1,ed+1,255:close
  189.  
  190.           open #1,"a1:xt,volumes":position #1,32,x
  191.           print #1:close
  192.           goto ret
  193.  
  194.                          ; :::::::::::::::::::::::::::::::::::
  195.                          ; external commands routines end here
  196.                          ; :::::::::::::::::::::::::::::::::::
  197.  
  198.                          ; edit a user's credit status
  199.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  200.  
  201. credit
  202.           input @2 "Credit record of user #" i$:if i$="" goto ret
  203.           a=val(i$):open #1,"a:users":position #1,128,a:input #1,i$,x$:close
  204.           if i$="" print '
  205. XT:       No such user...':goto ret
  206.           print '
  207. XT:       'i$' 'x$:open #1,"a1:xt.users":position #1,4,a:read #1,ram2,4:close
  208.           x=byte(2)+byte(3)*256:if not(byte(1)) input '
  209. XT:       This user does not yet have an
  210.              EXfer credit account.  Set one
  211.              up now [Y/N] ? ' i$:if i$="Y" then byte(1)=1:x=250
  212.           print '
  213. XT:       This user has 'x' credits.'
  214.           input @2 '
  215. XT:       Enter new value or press [RETURN]
  216.              to exit: ' i$:if i$="" goto credit.1
  217.           x=val(i$):if x<0 then x=0
  218.  
  219. credit.1
  220.           byte(2)=x mod 256:byte(3)=x/256:open #1,"a1:xt.users"
  221.           position #1,4,a:write #1,ram2,4:close:print '
  222. XT:       Credit status updated...':goto ret
  223.  
  224.                          ; optimize directory
  225.                          ; ~~~~~~~~~~~~~~~~~~
  226.  
  227. sort
  228.           on nocar goto terminate
  229.           input @2 "Sort by N)ame or T)ype ? " i$:if i$="" goto ret
  230.           print \"XT: "byte(4)" entries; sorting #002";:open #1,d1$:x=2
  231.  
  232.                          ; use the GS SBS algorithm
  233.  
  234. sort.1
  235.           position #1,32,x:input #1,a$:input #1,y$
  236.           position #1,32,x,20:read #1,ram2+9,10
  237.           position #1,32,x+1:input #1,b$:input #1,z$
  238.           if b$="" goto sort.3:else if a$="" goto sort.2
  239.           if (i$<>"T") and (a$<=b$) goto sort.3
  240.           if (i$="T") and (y$<=z$) goto sort.3
  241.  
  242.                          ; swap entries around
  243.  
  244. sort.2
  245.           position #1,32,x+1,20:read #1,ram2+20,10
  246.           position #1,32,x:print #1,b$:print #1,z$:write #1,ram2+20,10
  247.           position #1,32,x+1:print #1,a$:print #1,y$:write #1,ram2+9,10
  248.           if x>2 then x=x-1:print chr$(8,3);right$("00"+str$(x),3);
  249.           goto sort.1
  250.  
  251. sort.3
  252.           x=x+1:print chr$(8,3);right$("00"+str$(x),3);
  253.           if x<=byte(4) goto sort.1:else close:print chr$(8,3)"---"
  254.           goto ret
  255.  
  256.                          ; add a file to the directory
  257.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  258.  
  259.                          ; get filename to add
  260.  
  261. add
  262.           on nocar goto terminate
  263.           if nb=255 goto dfull
  264.           d=0:input @2 "Add: " i$:if i$="" goto ret
  265.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  266.           if l=0 goto add.1
  267.  
  268.                          ; see if existing directory entry is to be replaced
  269.  
  270.           input @2 \"XT: Replace existing entry ? " x$
  271.           if x$<>"Y" goto ret:else nb=l:d=byte(14)
  272.  
  273.                          ; file doesn't exist on ProDOS volume
  274.  
  275. add.1
  276.           i$=na$:gosub name:f$=bf$+f$:gosub chkfil:close
  277.           if not(a) goto add.2:else print \"XT: "f$" doesn't exist on "bf$
  278.           input @2 "    Add anyways ? " i$:if i$<>"Y" goto ret
  279.  
  280.                          ; compute some file info
  281.  
  282. add.2
  283.           gosub dtype:gosub size:gosub sfile:byte(9)=255:byte(14)=0
  284.  
  285.                          ; ask for a description
  286.  
  287.           on nocar goto add.3
  288.           if d print '
  289. XT:       Do you want to change the existing
  290.              file information ? ';:else print '
  291. XT:       Would you like to enter a short
  292.              description of this file ? ';
  293.           input @2 i$:i$=left$(i$,1):if i$<>"Y" goto add.3
  294.           edit(0):if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  295.           gosub edesc:if not(edit(2)) goto add.3
  296.           if d then byte(14)=d:kill #msg(d):update:goto add.i
  297.           a=1
  298.  
  299. add.f
  300.           if msg(a) then a=a+1:else d=a:goto add.i
  301.           if a>msg(0) then d=a:goto add.i
  302.           goto add.f
  303.  
  304. add.i
  305.           kill #msg(d):print #msg(d),un:print #6,na$
  306.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  307.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  308.           msg(d)=255:update
  309.  
  310. add.3
  311.           if d then byte(14)=d
  312.           d=1:if nb<>byte(4) goto write:else goto update
  313.  
  314.                          ; routine to create libraries
  315.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  316.  
  317.                          ; set defaults for new directory
  318.  
  319. create
  320.           if bf$<>"" goto create.1
  321.           bn$="New directory"+chr$(32,17):bf$="D:  "
  322.           byte(0)=1:byte(1)=1:byte(2)=1:byte(3)=0
  323.           byte(4)=2:byte(5)=0:byte(6)=0:zz$="x"
  324.  
  325.                          ; print info to the screen
  326.  
  327. create.1
  328.           on nocar goto terminate
  329.           if byte(7)>20 then byte(7)=20
  330.           if byte(8)>20 then byte(8)=20
  331.           if byte(0)>byte(1) then byte(1)=byte(0)
  332.           if byte(0)>byte(2) then byte(2)=byte(0)
  333.           print \\screen$"XT: Library #"right$("00"+str$(bb),3)"..."\
  334.           print "1-Name...."bn$\"2-Drive..."bf$\
  335.           print "3-Librarian: ";:if not(b1) print "None":else print b1
  336.           print \"4-Access level: "byte(0)\"5-Upload level: "byte(2)
  337.           print "6-D/load level: "byte(1)\
  338.           print "7-Auto-validate files ? ";:if not(byte(3)) print "No"
  339.           if byte(3) print "Yes"
  340.           print \"8-Uploads: 1K * "byte(7)" credits"
  341.           print "9-D/loads: 1K * "byte(8)" credits"
  342.           input @2 \"Change which [1-9] ? " i$:if i$="" goto create.2
  343.  
  344.                          ; change an option
  345.  
  346.           if i$="1" input @3 \"Name: " i$:bn$=left$(i$+chr$(32,29),30):i$=""
  347.           if (i$="2") and (info(5)) input @2 \"Drive: " i$:bf$=left$(i$+chr$(32,3),4)
  348.           if i$="3" input \"Librarian's user #: " x$:b1=val(x$)
  349.           if i$="3" then byte(6)=b1/256:byte(5)=b1 mod 256:i$=""
  350.           if i$="4" input \"Access level: " i$:byte(0)=val(i$):i$=""
  351.           if i$="5" input \"Upload level: " i$:byte(2)=val(i$):i$=""
  352.           if i$="6" input \"D/load level: " i$:byte(1)=val(i$):i$=""
  353.           if i$="8" input \"Upload multiplier: " i$:um=val(i$):byte(7)=um:i$=""
  354.           if i$="9" input \"D/load multiplier: " i$:dm=val(i$):byte(8)=dm:i$=""
  355.           if i$<>"7" goto create.1
  356.           if byte(3)=0 then byte(3)=255:goto create.1
  357.           byte(3)=0:goto create.1
  358.  
  359.                          ; see if the directory is to be saved
  360.  
  361. create.2
  362.           input \"XT: Save this ? " i$
  363.           if i$<>"Y" bb=ob:gosub log:push ret:goto getslt
  364.  
  365.                          ; update the bit-map
  366.           
  367.           d=1:print \"XT: Updating volume bit-map..."
  368.           open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  369.           poke ed+bb,byte(0):open #1,"a1:xt.bitmap"
  370.           write #1,ed+1,255:close:open #1,"a1:xt.volumes"
  371.           position #1,32,bb:print #1,bn$:close
  372.  
  373.                          ; save the stuff
  374.  
  375.           z$="a1:xv."+str$(bb):if zz$="x" create d1$
  376.           open #1,z$:print #1,bn$:print #1,bf$:write #1,ram2,9
  377.           close
  378.  
  379.           if zz$<>"x" gosub log:push ret:goto getslt
  380.  
  381.                          ; make a new message file for this library
  382.  
  383.           zz$="":print \"XT: Making description file..."
  384.           gosub make.msg:gosub log:push ret:goto getslt
  385.  
  386.                          ; return to main module
  387.                          ; ~~~~~~~~~~~~~~~~~~~~~
  388.  
  389. ret
  390.           link "a:exfer.seg","prompt"
  391.  
  392.                          ; loss of carrier
  393.                          ; ~~~~~~~~~~~~~~~
  394.  
  395. terminate
  396.           byte=ram2:byte(0)=xm+(pt*8):byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
  397.           open #1,"a1:xt.users":position #1,4,un:write #1,ram2,4:close
  398.           poke ram2,v:when$=ram+20:if v=0 then byte=ram+29:goto term.1
  399.           byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  400.           nibble(4)=ul/256:byte(4)=ul mod 256
  401.  
  402. term.1
  403.           clear:recall "a:variables":kill "a:variables"
  404.           if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  405.           link "a:main.seg","termin2"
  406.  
  407.                          ; ::::::::::::::::::::
  408.                          ; disk I/O subroutines
  409.                          ; ::::::::::::::::::::
  410.  
  411.                          ; get an empty slot
  412.                          ; ~~~~~~~~~~~~~~~~~
  413.  
  414. getslt
  415.           nb=0:open #1,d1$:for l=1 to byte(4)
  416.           position #1,32,l+1:input #1,i$
  417.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  418.           next:close:if not(nb) then nb=byte(4)
  419.           return
  420.  
  421.                          ; log to a volume
  422.                          ; ~~~~~~~~~~~~~~~
  423.  
  424. log
  425.           byte=ram2:fill ram2,64,0:bf$="":z$="a1:xv."+str$(bb)
  426.           open #1,z$:input #1,bn$:input #1,bf$
  427.           read #1,ram2,9:close:b1=byte(5)+byte(6)*256
  428.           b2=1:if byte(0) then b2=flag(byte(0))
  429.           b3=1:if byte(1) then b3=flag(byte(1))
  430.           b4=1:if byte(2) then b4=flag(byte(2))
  431.           um=byte(7):dm=byte(8):lb=(b1=un)
  432.           if info(5) then lb=1:b2=1:b3=1:b4=1
  433.           d1$="a1:xv."+str$(bb):d2$="a1:dv."+str$(bb)
  434.           if bf$ then ready d2$:bf$=left$(bf$,instr(":",bf$))
  435.           return
  436.  
  437.                          ; make a description file
  438.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  439.  
  440. make.msg
  441.           y=256:z=256:f$="a1:dv."+str$(bb)
  442.           y=(y/128)*128:z=(z/128)*128:l=(y/32)+(z/128)
  443.           fill ram2,64,0:byte(0)=z/128:byte(1)=y/32
  444.           create f$:open #1,f$:write #1,ram2,8
  445.           fill ram2,64,0:for x=1 to l:write #1,ram2,64
  446.           write #1,ram2,64:next:close:x=6:goto type
  447.  
  448.                          ; update "number of entries" counter
  449.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  450.  
  451. update
  452.           byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  453.           print #1,bf$:write #1,ram2,9:close
  454.  
  455.                          ; write a directory entry
  456.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  457.  
  458. write
  459.           open #1,d1$:position #1,32,nb+1:print #1,na$
  460.           print #1,ty$:write #1,ram2+9,10:close
  461.           push ret:goto getslt
  462.  
  463.                          ; read a directory entry
  464.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  465.  
  466. read
  467.           open #1,d1$:for l=1 to byte(4)
  468.           position #1,32,l+1:input #1,f$
  469.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  470.           next:close:l=0:return
  471.  
  472. read.1
  473.           input #1,ty$:read #1,ram2+9,10:close
  474.           return
  475.  
  476.                          ; read a file by slot #
  477.                          ; ~~~~~~~~~~~~~~~~~~~~~
  478.  
  479. nread
  480.           if left$(i$,1)="#" then i$=mid$(i$,2)
  481.           l=val(i$):if (l<1) or (l>253) then l=0:return
  482.           open #1,d1$:position #1,32,l
  483.           input #1,f$:if f$="" close #1:l=0:return
  484.           input #1,ty$:read #1,ram2+9,10:close #1
  485.           i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
  486.  
  487.                          ; show a directory header
  488.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  489.  
  490. dir.h
  491.           print #y,right$("00"+str$(bb),3)": "bn$;
  492.           print #y,"                        Librarian: "right$("00"+str$(b1),3)
  493.           print #y,'
  494.           #  Filename        Typ I Size Uploaded Uploader Downloaded Miscellaneous'\
  495.           return
  496.  
  497.                          ; display an entry
  498.  
  499. dir.e
  500.           print #y,right$("00"+str$(l+1),3)" "f$" "ty$" ";
  501.           if byte(14) print #y,"Y ";:else print #y,"N ";
  502.           x=byte(10)+byte(11)*256:print #y,right$("   "+str$(x),4)" ";
  503.           b$=when$:if (not(byte(9))) print #y,"VALIDATE";:else print #y,b$;
  504.           z=byte(18):x=byte(12)+byte(13)*256
  505.           print #y," User " right$("00"+str$(x),3);
  506.           print #y,"  "right$("00"+str$(z),3)" times "a$;
  507.           return
  508.  
  509.                          ; find the type of a file
  510.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  511.  
  512. dtype
  513.           use "a1:xtyp",f$:x=peek(ram2+32)
  514.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  515.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  516.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  517.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):goto id
  518.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  519.  
  520.                          ; detect Macbinary or Binary ][ formats
  521.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  522.  
  523. id
  524.           x$=right$(f$,4)
  525.           if (x$=".BNY") or (x$=".BQY") or (x$=".SQZ") then ty$=right$(x$,3):return
  526.           open #1,f$:read #1,ram2+32,3:close #1
  527.           if (byte(32)=10) and (byte(33)=71) and (byte(34)=76) then ty$="BNY"
  528.           if (ty$="???") and ((byte(32)=0) and (byte(33))) then ty$="MAC"
  529.           return
  530.  
  531.                          ; set a file type
  532.                          ; ~~~~~~~~~~~~~~~
  533.  
  534. type
  535.           use "a1:xtyp",f$,x:return
  536.  
  537.                          ; return size of F$ in A
  538.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  539.  
  540. size
  541.           open #1,f$:a=size(1)/2+1:close:return
  542.  
  543.                          ; see if file exists
  544.                          ; ~~~~~~~~~~~~~~~~~~
  545.  
  546. chkfil
  547.           open #1,f$:a=mark(1):return
  548.  
  549.                          ; :::::::::::::::::::
  550.                          ; special subroutines
  551.                          ; :::::::::::::::::::
  552.  
  553.                          ; get a file description
  554.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  555.  
  556. edesc
  557.           print '
  558. Enter     description: 'edit(3)' cols, [4K] max 
  559. [DONE]    when finished, [.H] for help'
  560.           edit(1):return
  561.  
  562.                          ; convert to a valid ProDOS name
  563.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  564.  
  565.                          ; shorten I$ to directory length
  566.  
  567. name
  568.           if len(i$)>15 then i$=left$(i$,15)
  569.           i$=i$+chr$(1)
  570.  
  571.                          ; make sure the first char is a letter
  572.  
  573. name.0
  574.           a=asc(left$(i$,1)):if a=1 pop:goto ret
  575.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  576.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  577.           i$=mid$(i$,2):goto name.0
  578.  
  579.                          ; remove symbols from the name
  580.  
  581. name.1
  582.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  583.           if (a>64) and (a<91) goto name.2
  584.           if (a>96) and (a<123) goto name.2
  585.           if (a>47) and (a<58) goto name.2
  586.           if a=46 goto name.2:else goto name.3
  587.  
  588.                          ; add a valid character
  589.  
  590. name.2
  591.           f$=f$+chr$(a)
  592.  
  593.                          ; if we dont have a name, return to the prompt
  594.  
  595. name.3
  596.           next:if f$="" pop:return
  597.           if len(f$)>15 then f$=left$(f$,15)
  598.           return
  599.  
  600.                          ; set file information
  601.                          ; ~~~~~~~~~~~~~~~~~~~~
  602.  
  603. sfile
  604.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  605.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  606.           when$="x":if lb then byte(9)=255
  607.           return
  608.  
  609.                          ; ::::::::::::::
  610.                          ; error messages
  611.                          ; ::::::::::::::
  612.  
  613. nfile
  614.           print \\"XT:"chr$(7)" No such file...":goto ret
  615.  
  616. dfull
  617.           print \\"XT:"chr$(7)" Directory full...":goto ret
  618.